<%
'######################################################################
'## util.saveremote.asp
'## -------------------------------------------------------------------
'## Feature     :   AspBox Mvc SaveRemote-Util Block
'## Version     :   v1.0
'## Author      :   Lajox(lajox@19www.com)
'## Update Date :   2012/06/10 23:18
'## Description :   AspBox Mvc SaveRemote-Util Block(SaveRemote工具拓展模块)
'######################################################################

Class Cls_Util_SaveRemote
	Private sAllowExt, nAllowSize, sUploadDir, sContentPath
	Private sFileExt, sOriginalFileName, sSaveFileName, sPathFileName, nFileNum
	Private SaveFilePath,UploadPath,strUploadDir

	Private Sub Class_Initialize()
		InitUpload()
	End Sub

	Sub InitUpload() '初始化上传限制数据
		sUploadDir		= "/"										'上传文件路径
		UploadPath		= "UploadImgs/"								'上传文件目录
		sUploadDir		= sUploadDir & UploadPath					'上传文件路径
		nAllowSize		= 102400									'允许上传的文件大小
		sAllowExt		= "gif|jpg|bmp|png|jpe|jpeg|tif|iff"		'上传文件类型
		sAllowExt		= Replace(Replace(LCase(sAllowExt),"asp",""),"asa","")
	End Sub

	Sub UploadRemote() '自动获取远程文件
		'Server.ScriptTimeout = 99999
		Dim strContent, i, o_save
		strUploadDir = CreatePath(sUploadDir)
		sUploadDir = sUploadDir & strUploadDir
		AB.Use "Form"
		AB.Form.Init()
		For i=0 To AB.Form.Count-1
			strContent = strContent & AB.Form(i)
		Next
		If sAllowExt <> "" Then
			Set o_save = New Cls_Util_Down
			o_save.RemoteDir = sUploadDir
			o_save.AllowMaxSize = nAllowSize
			o_save.AllowExtName = sAllowExt
			strContent = "http://www.baidu.com/images/logo.gif"
			strContent = o_save.ChangeRemote(strContent)
			sOriginalFileName = o_save.RemoteFileName '原文件名
			sSaveFileName = o_save.LocalFileName '保存的文件名
			sPathFileName = o_save.LocalFilePath
			SaveFilePath = Replace(sPathFileName, "", "",1,-1,1) '保存路径
		End If
		Response.Write "<html><head><title>远程上传</title><meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8""/></head><body>" & _
			"<input type=""hidden"" id=""UploadText"" value=""" & ConverHTML(strContent) & """/>" & _
			"</body></html>"
		Response.write "文件保存成功,路径：" & SaveFilePath
		Set o_save = Nothing
	End Sub

	Function CreatePath(Byval fromPath)
		On Error Resume Next
		Dim uploadpath
		uploadpath = Year(Now) & "-" & Month(Now) '以年月创建上传文件夹，格式：2007-8
		uploadpath = Replace(uploadpath, ".", "_")
		If CreateFolderEx(Server.MapPath(fromPath & uploadpath)) Then
			CreatePath = uploadpath & "/"
		Else
			CreatePath = ""
		End If
		On Error Goto 0
	End Function

	Function CreateFolderEx(Byval sPath)
		On Error Resume Next
		Dim strPath,fso
		sPath = Replace(sPath, "\\", "\")
		Err=False
		Set fso = Server.CreatObject(AB.fsoName)
		If Trim(sPath) = "" Then Exit Function
		If fso.FolderExists(sPath) Then
			CreateFolderEx=True
			Exit Function
		End If
		strPath = sPath
		If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
		strPath = Left(strPath, InStrRev(strPath, "\") - 1)
		If fso.FolderExists(strPath) = False Then
			CreateFolderEx (strPath)
		End If
		If fso.FolderExists(sPath) = False Then fso.CreateFolder sPath
		If Err Then
			  CreateFolderEx=False
		 Else
			  CreateFolderEx=True
		 End If
		 Set fso = Nothing
		 On Error Goto 0
	End Function

	Function ConverHTML(Byval str)
		Dim sTemp
		sTemp = str
		ConverHTML = ""
		If IsNull(sTemp) = True Then
			Exit Function
		End If
		sTemp = Replace(sTemp, "&", "&amp;")
		sTemp = Replace(sTemp, "<", "&lt;")
		sTemp = Replace(sTemp, ">", "&gt;")
		sTemp = Replace(sTemp, Chr(34), "&quot;")
		ConverHTML = sTemp
	End Function
End Class

Class Cls_Util_Down
	Private s_fsoName, s_steamName, s_xmlhttpName
	Private sUploadDir,nAllowSize,sAllowExt
	Private sOriginalFileName,sSaveFileName,sPathFileName

	Private Sub Class_Initialize()
		s_fsoName 		= AB.FsoName
		s_steamName		= AB.steamName
		s_xmlhttpName 	= "Micro"+"soft"+"."+"XML"+"HTTP"
		sUploadDir 		= "/UploadFile/"
		nAllowSize 		= 50000
		sAllowExt 		= "gif|jpg|png|bmp"
	End Sub

	Private Sub Class_Terminate
		On Error Goto 0
	End Sub

	Public Property Get RemoteFileName()
		RemoteFileName = sOriginalFileName
	End Property

	Public Property Get LocalFileName()
		LocalFileName = sSaveFileName
	End Property

	Public Property Get LocalFilePath()
		LocalFilePath = sPathFileName
	End Property

	Public Property Let RemoteDir(Byval strDir)
		sUploadDir = strDir
	End Property
	Public Property Get RemoteDir()
		RemoteDir = sUploadDir
	End Property

	Public Property Let AllowMaxSize(Byval intSize)
		nAllowSize = intSize
	End Property
	Public Property Get AllowMaxSize()
		AllowMaxSize = nAllowSize
	End Property

	Public Property Let AllowExtName(Byval strExt)
		sAllowExt = strExt
	End Property
	Public Property Get AllowExtName()
		AllowExtName = sAllowExt
	End Property

	Public Function ChangeRemote(Byval sHTML)
		Dim s_Content
		s_Content = sHTML
		Dim re, matches, item, SaveFileName, SaveFileType
		Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True
		re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([A-Za-z0-9_-])+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & sAllowExt & ")))"
		Set matches = re.Execute(s_Content)
		Dim a_RemoteUrl(), n, i, bRepeat : n = 0
		' 转入无重复数据
		For Each item In matches
			If n = 0 Then
				n = n + 1
				ReDim a_RemoteUrl(n)
				a_RemoteUrl(n) = item
			Else
				bRepeat = False
				For i = 1 To UBound(a_RemoteUrl)
					If UCase(item) = UCase(a_RemoteUrl(i)) Then
						bRepeat = True
						Exit For
					End If
				Next
				If bRepeat = False Then
					n = n + 1
					ReDim Preserve a_RemoteUrl(n)
					a_RemoteUrl(n) = item
				End If
			End If
		Next
		Set re = Nothing
		' 开始替换操作
		Dim nFileNum, sContentPath,strFilePath
		sContentPath = RelativePath2RootPath(sUploadDir)
		nFileNum = 0
		For i = 1 To n
			SaveFileType = Mid(a_RemoteUrl(i), InStrRev(a_RemoteUrl(i), ".") + 1)
			SaveFileName = GetRndFileName(SaveFileType)
			strFilePath = sUploadDir & SaveFileName
			If SaveRemoteFile(strFilePath, a_RemoteUrl(i)) = True Then
				nFileNum = nFileNum + 1
				If nFileNum > 0 Then
					sOriginalFileName = sOriginalFileName & "|"
					sSaveFileName = sSaveFileName & "|"
					sPathFileName = sPathFileName & "|"
				End If
				sOriginalFileName = sOriginalFileName & Mid(a_RemoteUrl(i), InStrRev(a_RemoteUrl(i), "/") + 1)
				sSaveFileName = sSaveFileName & SaveFileName
				sPathFileName = sPathFileName & sContentPath & SaveFileName
				s_Content = Replace(s_Content, a_RemoteUrl(i), sContentPath & SaveFileName, 1, -1, 1)
			End If
		Next
		sOriginalFileName = Replace(sOriginalFileName, "|", vbNullString, 1, 1)
		sSaveFileName = Replace(sSaveFileName, "|", vbNullString, 1, 1)
		sPathFileName = Replace(sPathFileName, "|", vbNullString, 1, 1)
		ChangeRemote = s_Content
	End Function

	Public Function RelativePath2RootPath(Byval url)
		Dim sTempUrl
		sTempUrl = url
		If Left(sTempUrl, 1) = "/" Then
			RelativePath2RootPath = sTempUrl
			Exit Function
		End If
		Dim m_strPath
		m_strPath = Request.ServerVariables("SCRIPT_NAME")
		m_strPath = Left(m_strPath, InStrRev(m_strPath, "/") - 1)
		Do While Left(sTempUrl, 3) = "../"
			sTempUrl = Mid(sTempUrl, 4)
			m_strPath = Left(m_strPath, InStrRev(m_strPath, "/") - 1)
		Loop
		RelativePath2RootPath = m_strPath & "/" & sTempUrl
	End Function

	Public Function GetRndFileName(sExt)
		Dim sRnd
		Randomize
		sRnd = Int(900 * Rnd) + 100
		GetRndFileName = Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) & sRnd & "." & sExt
	End Function

	Public Function SaveRemoteFile(Byval s_LocalFileName, Byval s_RemoteFileUrl)
		On Error Resume Next
		Dim GetRemoteData
		Dim bError
		bError = False
		SaveRemoteFile = False
		Dim Retrieval
		Set Retrieval = Server.CreateObject(s_xmlhttpName)
		With Retrieval
			'.setTimeouts 1000,1000,1000,1000
			.Open "GET", s_RemoteFileUrl, False, "", ""
			.setRequestHeader "Referer", s_RemoteFileUrl
			.send
			If .readyState <> 4 Then Exit Function
			If .Status > 300 Then Exit Function
			GetRemoteData = .responseBody
		End With
		Set Retrieval = Nothing
		If LenB(GetRemoteData) < 100 Then Exit Function
		Dim Ads
		Set Ads = NewAsp.CreateAXObject(s_steamName)
		With Ads
			.Type = 1
			.Open
			.Write GetRemoteData
			.SaveToFile Server.CreateObject(s_LocalFileName), 2
			.Cancel
			.Close
		End With
		Set Ads = Nothing
		If Err.Number = 0 And bError = False Then
			SaveRemoteFile = True
		Else
			SaveRemoteFile = False
			Err.Clear
		End If
		On Error Goto 0
	End Function
End Class
%>